home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / ace_gpl_release / src / lib / asm / string.s < prev    next >
Encoding:
Text File  |  1998-10-04  |  18.2 KB  |  864 lines
  1. ;
  2. ; string.s -- an ACE linked library module: string functions.
  3. ; Copyright (C) 1998 David Benn
  4. ; 
  5. ; This program is free software; you can redistribute it and/or
  6. ; modify it under the terms of the GNU General Public License
  7. ; as published by the Free Software Foundation; either version 2
  8. ; of the License, or (at your option) any later version.
  9. ;
  10. ; This program is distributed in the hope that it will be useful,
  11. ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. ; GNU General Public License for more details.
  14. ;
  15. ; You should have received a copy of the GNU General Public License
  16. ; along with this program; if not, write to the Free Software
  17. ; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  18. ;
  19. ; Author: David J Benn
  20. ;   Date: 3rd-30th November, 1st-13th December 1991,
  21. ;      20th, 23rd,25th-27th January 1992, 
  22. ;         2nd,4th,6th,12th-19th,21st-24th,29th February 1992,
  23. ;      1st,14th March 1992,
  24. ;      4th,7th,21st,22nd,26th April 1992,
  25. ;      2nd,3rd,5th,7th,8th,10th-17th May 1992,
  26. ;      6th,8th,11th,12th,28th,30th June 1992,
  27. ;      1st-3rd,13th,14th,18th-20th,22nd July 1992,
  28. ;      9th August 1992,
  29. ;      5th,13th,29th,30th December 1992,
  30. ;      6th,12th January 1993,
  31. ;      7th,14th,16th,18th February 1993,
  32. ;      1st,14th March 1993,
  33. ;      9th,25th,30th May 1993,
  34. ;      6th,29th June 1993,
  35. ;      9th,11th October 1993,
  36. ;      19th March 1994,
  37. ;      12th,25th July 1994
  38. ;
  39. ; registers d0-d6 and a0-a3 are modified by some of the following. BEWARE!
  40. ;
  41. ; a4,a5 are used by link/unlk.
  42. ; a6 is library base holder.
  43. ; a7 is stack pointer. 
  44. ; d7 is used for array index calculations.
  45. ;
  46.  
  47. ; misc. defines
  48. MAXSTRINGSIZE     equ 1024
  49. VANILLAKEY        equ $00200000
  50. UserPort         equ 86
  51.  
  52. Class        equ 0        ; member in IntuiInfo structure
  53. Code        equ 4        ; member in IntuiInfo structure
  54.                 ; (see intuievent.h)
  55. pr_CLI        equ 172
  56. cli_CommandName    equ 16
  57.  
  58.        ; string functions
  59.     xdef    _htol
  60.        xdef      _leftstr
  61.        xdef      _rightstr
  62.        xdef      _midstr
  63.     xdef    _ucase
  64.     xdef    _inputstring
  65.     xdef    _hexstrlong
  66.     xdef    _hexstrshort
  67.     xdef    _octstr
  68.     xdef    _binstr
  69.     xdef    _strlong
  70.     xdef    _strshort
  71.     xdef    _inkey
  72.     xdef    _spacestring
  73.     xdef    _spc
  74.     xdef    _stringstr
  75.     xdef    _instr
  76.  
  77.        ; external references 
  78.     xref    _strlen
  79.     xref    _strcpy
  80.     xref    _streq
  81.  
  82.     xref    _shortfmt
  83.     xref    _longfmt
  84.     xref    _shorthexfmt
  85.     xref    _longhexfmt
  86.     xref    _zerostr
  87.     xref    _colonstr
  88.  
  89.     xref    _tmpstring
  90.     xref    _deststraddr
  91.     xref    _count
  92.     xref    _ucasestring
  93.     xref    _spacestraddress
  94.     xref    _stringstraddress
  95.     xref    _octdigit
  96.     xref    _bindigit
  97.     xref    _inkeybuf
  98.     xref    _rawinpbuf
  99.     xref    _rawinpaddr
  100.     xref    _instrposn
  101.     xref    _search_offset
  102.     xref    _targetch
  103.     xref    _x_string
  104.     xref    _y_string
  105.     xref    _x_strlen
  106.     xref    _y_strlen
  107.  
  108.        xref      _putchar
  109.     xref    _sprintf
  110.     xref    _strval
  111.       xref      _LVOSPFlt
  112.     xref    _LVOSPAdd
  113.        xref      _LVOSPDiv
  114.        xref      _LVOSPTst
  115.     xref    _LVOSPNeg
  116.        xref      _LVOWrite
  117.     xref    _LVORead
  118.     xref    _LVOWaitForChar
  119.     xref    _LVOExamine
  120.     xref    _LVOUnLock
  121.       xref      _DOSBase    
  122.        xref      _MathBase
  123.        xref      _stdout
  124.     xref    _stdin
  125.     xref    _turncursoron
  126.     xref    _turncursoroff
  127.         xref     _AbsExecBase
  128.     xref    _LVOFindTask
  129.     xref    _Wdw
  130.     xref    _Wdw_id
  131.     xref    _IntuiMode
  132.     xref    _GetIntuiEvent
  133.     xref    _ClearIntuiEvent
  134.  
  135.     SECTION string_code,CODE
  136.  
  137. ;*** STRING FUNCTIONS ***
  138.  
  139. ;
  140. ; _htol - returns a LONG value in d0 from a HEX string pointed to by a1.
  141. ; _htol assumes that all digits are legal (1..9, a..f) and lowercase. 
  142. ;
  143. _htol:
  144.     moveq    #0,d0
  145. _htoloop:
  146.     cmpi.b    #0,(a1)
  147.     beq.s    _quithtol        ; EOS?
  148.  
  149.     cmpi.b    #57,(a1)        
  150.     ble.s    _decdigit        ; <= 9 ?
  151.  
  152.     ; <= F -> hex digit
  153.     move.b    (a1)+,d1        ; hex digit
  154.     ext.w    d1
  155.     ext.l    d1
  156.     sub.l    #87,d1
  157.     lsl.l    #4,d0            
  158.     add.l    d1,d0
  159.     
  160.     bra.s    _htoloop
  161.     
  162. _decdigit:
  163.     move.b    (a1)+,d1        ; decimal digit
  164.     ext.w    d1
  165.     ext.l    d1
  166.     sub.l    #48,d1
  167.     lsl.l    #4,d0            
  168.     add.l    d1,d0
  169.     
  170.     bra.s    _htoloop
  171. _quithtol:    
  172.     rts
  173.  
  174. ;
  175. ; LEFT$ function. expects string address in a0, sub-string address in a1
  176. ; and index in d0 (SHORT).
  177. ; returns address of sub-string in a0.
  178. ;
  179. _leftstr:
  180.     move.l    a1,a3        ; save address of target sub-string
  181. _leftstrloop:
  182.     cmpi.w    #0,d0        ; transfered n bytes?
  183.     ble.s    _leftstrquit    
  184.     cmpi.b    #0,(a0)        ; EOS?
  185.     beq.s    _leftstrquit
  186.     move.b    (a0)+,(a1)+    ; copy a byte
  187.     subq    #1,d0
  188.     bra.s    _leftstrloop
  189. _leftstrquit:
  190.     move.b    #0,(a1)
  191.     move.l    a3,a0        ; return address of sub-string
  192.     rts
  193.  
  194. ;
  195. ; RIGHT$ function. expects string address in a0, sub-string address in a1 
  196. ; and index in d0 (SHORT).
  197. ; returns address of sub-string in a0.
  198. ;    
  199. _rightstr:
  200.     move.l    a1,a3            ; get address of target sub-string
  201.     move.w    d0,d1        ; save length of sub-string
  202.         cmpi.w    #0,d0
  203.     ble.s    _rightstrquit    ; return NULL string if requested length <= 0
  204.     move.l    a0,a2
  205.     jsr    _strlen        ; d0 = length of string pointed to by a2
  206.     ext.l    d1        
  207.     sub.l    d1,d0        ; starting position = strlen-index
  208.     cmpi.l    #0,d0        
  209.     bgt.s    _rightstrpoint  ; index < strlen(string) -> okay
  210.     moveq    #0,d0        ; index >= strlen(string) so return whole string
  211. _rightstrpoint:
  212.     add.l    d0,a0        ; point to it
  213. _rightstrloop:
  214.     cmpi.b    #0,(a0)        ; EOS?
  215.     beq.s    _rightstrquit
  216.     move.b    (a0)+,(a1)+    ; copy a byte
  217.     subq    #1,d0
  218.     bra.s    _rightstrloop
  219. _rightstrquit:
  220.     move.b    #0,(a1)
  221.     move.l    a3,a0        ; address of sub-string
  222.     rts
  223.  
  224. ;
  225. ; MID$ function. Expects string address in a0, sub-string address in a1,
  226. ; start posn in d0 and length of sub-string in d1 (both SHORT).
  227. ; returns address of sub-string in a0.
  228. ;
  229. ; MID$(X$,n[,m]) -> a0=X$,d0=n,d1=m
  230. ;    
  231. _midstr:
  232.     move.l    a1,a3        ; save address of target sub-string
  233.     move.w    d0,d2        ; save start position (n)
  234.     move.l    a0,a2
  235.     jsr    _strlen        ; d0 = length of string pointed to by a2
  236.     cmpi.w    #-1,d1        
  237.     bne.s    _midstr1
  238.     move.w    d0,d1        ; if m is -1 -> take FULL length of string 
  239. _midstr1:
  240.     ext.l    d2
  241.     cmp.l    d0,d2        
  242.     bgt.s    _midstrquit    ; n > strlen(string)? -> quit
  243.     cmpi.w    #0,d1
  244.     bge.s    _midstrpoint    ; negative? -> make zero
  245.     moveq    #0,d1
  246. _midstrpoint:
  247.     add.l    d2,a0        ; start at nth character
  248.     subq    #1,a0        
  249. _midstrloop:
  250.     cmpi.w    #0,d1        
  251.     beq.s    _midstrquit    ; m characters copied?
  252.     cmpi.b    #0,(a0)        
  253.     beq.s    _midstrquit    ; EOS?
  254.     move.b    (a0)+,(a1)+    ; copy a byte
  255.     subq    #1,d1
  256.     bra.s    _midstrloop
  257. _midstrquit:
  258.     move.b    #0,(a1)
  259.     move.l    a3,a0        ; return sub-string address
  260.     rts
  261.     
  262. ;
  263. ; UCASE$ - Convert lower case characters in string (a1) to upper case. 
  264. ;        - Destination string in a0.
  265. ;
  266. _ucase:
  267.     ; store destination address
  268.      move.l    a0,_ucasestring
  269.  
  270.     ; make a copy
  271.     jsr    _strcpy
  272.  
  273.     ; main loop
  274.     movea.l    _ucasestring,a1
  275. _ucaseloop:
  276.     cmpi.b    #0,(a1)    
  277.     beq.s    _ucaseexit    ; EOS?
  278.     cmpi.b  #97,(a1)    
  279.     blt.s    _nextchar    ; (a0) < 'a'?
  280.     cmpi.b    #122,(a1)    
  281.     bgt.s    _nextchar    ; (a0) > 'z'?
  282.     sub.b    #32,(a1)    ; 'a'..'z' -> make 'A'..'Z'
  283. _nextchar:
  284.     addq    #1,a1
  285.     bra.s    _ucaseloop
  286. _ucaseexit:
  287.     movea.l    _ucasestring,a0
  288.     rts
  289.  
  290. ;
  291. ; get a string from _stdin and return it's address in a0.
  292. ; expects target string address in a1. 
  293. ;
  294. _inputstring:
  295.         move.l  a1,a3        ; save input string address
  296.  
  297.     jsr    _turncursoron
  298.  
  299.     ; get the string
  300.     cmpi.w    #0,_Wdw_id
  301.     beq.s    _inputconstring    ; if Wdw-id = 0 then window is CON: 
  302.     jsr    _inputrawstring    ; if Wdw-id <> 0 then window is RAW:
  303.     bra.s    _exitinputstring
  304.  
  305. _inputconstring:
  306.     move.l    _DOSBase,a6    
  307.     move.l    _stdin,d1
  308.     move.l    a3,d2        ; get start address of input string    
  309.     move.l    #MAXSTRINGSIZE-1,d3; allow the max string size. d0=actual.
  310.     jsr    _LVORead(a6)
  311.     move.l    a3,a0
  312.     subq    #1,d0
  313.     clr.b    0(a0,d0)    ; append EOS character    
  314.  
  315. _exitinputstring:
  316.     jsr    _turncursoroff
  317.  
  318.     move.l    a3,a0        ; restore start address of input string 
  319.  
  320.     rts
  321.  
  322. ;
  323. ; INPUT a string from a RAW: window. a3 points to input string.
  324. ; Destructive backspace (ASCII 8) is handled as expected, while
  325. ; all other characters are passed into the final string.
  326. ;
  327. _inputrawstring:
  328.     move.l    a3,_rawinpaddr    ; save the address
  329.  
  330. _waitforinput:
  331.     move.l    _DOSBase,a6
  332.     move.l    _stdin,d1
  333.     moveq    #1,d2
  334.     jsr    _LVOWaitForChar(a6)
  335.     cmpi.w    #0,d0
  336.     beq.s    _waitforinput    
  337.  
  338.     ; get pending character
  339.     move.l    _DOSBase,a6
  340.     move.l    _stdin,d1
  341.     move.l    #_rawinpbuf,d2          ; address of buffer    
  342.     moveq    #1,d3            
  343.     jsr    _LVORead(a6)        ; read 1 character        
  344.  
  345.     ; is it a destructive backspace? 
  346.     cmpi.b    #8,_rawinpbuf
  347.     bne.s    _displayrawchar        ; no -> just display it    
  348.  
  349.     ; BS: are we back at the start of the line?
  350.     cmpa.l    _rawinpaddr,a3
  351.     beq.s    _waitforinput        ; yes -> can't delete any more!
  352.  
  353. _displayrawchar:
  354.     move.l    _DOSBase,a6
  355.     move.l    _stdout,d1
  356.     move.l    #_rawinpbuf,d2
  357.     moveq    #1,d3
  358.     jsr    _LVOWrite(a6)        ; display character
  359.  
  360.     ; is it a destructive backspace? 
  361.     cmpi.b    #8,_rawinpbuf
  362.     bne.s    _addchartostring    ; not BS, so keep it
  363.  
  364.     ; delete last character
  365.     suba.l    #1,a3            ; otherwise, move back one character
  366.  
  367.     move.l    _DOSBase,a6
  368.     move.l    _stdout,d1
  369.     move.b    #32,_rawinpbuf
  370.     move.l    #_rawinpbuf,d2
  371.     moveq    #1,d3
  372.     jsr    _LVOWrite(a6)        ; write a space over last character
  373.     
  374.     move.l    _DOSBase,a6
  375.     move.l    _stdout,d1
  376.     move.b    #8,_rawinpbuf        
  377.     move.l    #_rawinpbuf,d2
  378.     moveq    #1,d3
  379.     jsr    _LVOWrite(a6)        ; move back to "wiped-out" character
  380.  
  381.     bra    _waitforinput        ; then wait for next character
  382.  
  383. _addchartostring:
  384.     ; add to string
  385.     cmpi.b    #13,_rawinpbuf        ; carriage return? -> EOS
  386.     beq.s    _exitrawinput
  387.  
  388.     move.b    _rawinpbuf,(a3)+    ; add character to string
  389.  
  390.     bra    _waitforinput        ; wait for next character
  391.     
  392. _exitrawinput:
  393.     move.b    #0,(a3)
  394.     move.l    _rawinpaddr,a3        ; address of string
  395.  
  396.     move.l    #10,-(sp)
  397.     jsr    _putchar        ; Line Feed
  398.     addq    #4,sp
  399.  
  400.     rts
  401.  
  402. ;
  403. ; HEX$ - returns hexadecimal string form (a0) of short decimal value (d0).
  404. ;
  405. _hexstrshort:
  406.     move.l  a0,a3        ; save destination string address
  407.     move.w    d0,-(sp)    ; push short value
  408.     pea    _shorthexfmt    ; push format string
  409.     move.l    a0,-(sp)    ; push destination string
  410.     jsr    _sprintf
  411.     add.l    #10,sp
  412.     move.l    a3,a0        ; restore destination string address
  413.     rts
  414. ;
  415. ; HEX$ - returns hexadecimal string form (a0) of long decimal value (d0).
  416. ;
  417. _hexstrlong:
  418.     move.l  a0,a3        ; save destination string address
  419.     move.l    d0,-(sp)    ; push long value
  420.     pea    _longhexfmt    ; push format string
  421.     move.l    a0,-(sp)    ; push destination string
  422.     jsr    _sprintf
  423.     add.l    #12,sp
  424.     move.l    a3,a0        ; restore destination string address
  425.     rts
  426. ;
  427. ; OCT$ - returns octal string form (a0) of long decimal value (d0).
  428. ;
  429. _octstr:
  430.     move.l    a0,a3        ; save address of dest string
  431.  
  432.     ; if zero, make a string with 1 digit: "0"
  433.     cmpi.l    #0,d0
  434.     bne.s    _octnotzero
  435.     move.b    #48,(a0)+    ; string[0]='0'
  436.     move.b    #0,(a0)        ; EOS
  437.     movea.l    a3,a0
  438.     rts
  439.  
  440. _octnotzero:
  441.     move.w    #0,d2        ; cc=0
  442.     lea    _octdigit,a0
  443.  
  444. _octloop:
  445.     cmpi.l    #0,d0
  446.     beq.s    _reversedigits    ; until num == 0
  447.     
  448.     ; get remainder
  449.     move.l    d0,d1        ; num
  450.     move.l    d0,d3        
  451.     lsr.l    #3,d3        ; num\8
  452.     lsl.l    #3,d3        ; quotient*8
  453.     sub.l    d3,d1        ; r=num-(quotient*8) = num % 8
  454.         
  455.     add.l    #48,d1        ; ASCII = 48 + d1
  456.     and.b    #$ff,d1        
  457.     move.b    d1,(a0)+    ; x[cc]=r
  458.     addi.w    #1,d2        ; cc++ (keep count of characters)
  459.  
  460.     lsr.l    #3,d0        ; num \= 8
  461.     
  462.     bra.s    _octloop
  463.  
  464. _reversedigits:
  465.     move.l    a3,a1        ; string address
  466.  
  467. _makeoctstring:
  468.     cmpi.w    #0,d2
  469.     ble.s    _stripoctzeros    ; while cc > 0
  470.  
  471.     subi.w    #1,d2        ; --cc
  472.     move.b    -(a0),(a1)+    ; string[cc] = x[cc]
  473.  
  474.     bra.s    _makeoctstring
  475.  
  476. _stripoctzeros:
  477.     move.b    #0,(a1)        ; EOS
  478.     move.l    a3,a1        ; start of string 
  479.  
  480. _octstriploop:
  481.     ; strip leading zeros
  482.     cmpi.b    #0,(a1)
  483.     beq.s    _exitoctstr    ; exit if EOS (null string?)
  484.  
  485.     cmpi.b    #48,(a1)
  486.     bgt.s    _exitoctstr    ; digit > 0? -> exit    
  487.  
  488.     adda.l    #1,a1
  489.  
  490.     bra.s    _octstriploop
  491.         
  492. _exitoctstr:        
  493.     move.l    a1,a0        ; return destination string address
  494.     rts
  495.  
  496. ;
  497. ; STR$ - returns string form (a0) of short decimal value (d0). 
  498. ;
  499. _strshort:
  500.     move.l  a0,a3        ; save destination string address
  501.     cmpi.w  #0,d0        
  502.     blt.s    _strshortdo    ; is value >= 0? 
  503.     move.b    #32,(a0)+    ; yes -> leading space
  504. _strshortdo: 
  505.     move.w    d0,-(sp)    ; push short value
  506.     pea    _shortfmt    ; push format string
  507.     move.l    a0,-(sp)    ; push destination string
  508.     jsr    _sprintf
  509.     add.l    #10,sp
  510.     move.l    a3,a0        ; restore destination string address
  511.     rts
  512.  
  513. ;
  514. ; STR$ - returns string form (a0) of long decimal value (d0). 
  515. ;
  516. _strlong:
  517.     move.l  a0,a3        ; save destination string address
  518.     move.l  a0,a3        ; save destination string address
  519.     cmpi.l  #0,d0        
  520.     blt.s    _strlongdo    ; is value >= 0? 
  521.     move.b    #32,(a0)+    ; yes -> leading space
  522. _strlongdo: 
  523.     move.l    d0,-(sp)    ; push long value
  524.     pea    _longfmt    ; push format string
  525.     move.l    a0,-(sp)    ; push destination string
  526.     jsr    _sprintf
  527.     add.l    #12,sp
  528.     move.l    a3,a0        ; restore destination string address
  529.     rts
  530.  
  531. ;
  532. ; INKEY$ - returns a single character string (address in d0) from stdin if 
  533. ;       a character is pending or the NULL string if not. If IntuiMode
  534. ;       is 1, the Window's IDCMP port is checked for a VANILLAKEY event.
  535. ;
  536. _inkey:
  537.     cmpi.b    #0,_IntuiMode
  538.     beq    _stdinkey
  539.  
  540.     ; check for Intuition event
  541.     movea.l    _Wdw,a0
  542.     move.l    UserPort(a0),-(sp) ; get window's UserPort (Wdw->UserPort)
  543.     jsr    _GetIntuiEvent
  544.     addq    #4,sp
  545.  
  546.     tst.l    d0
  547.     bne.s    _checkforkey    ; an event took place!
  548.     bra.s    _quitintuiinkey ; no event took place
  549.  
  550. _checkforkey:
  551.     movea.l    d0,a0        ; pointer to IntuiInfo structure
  552.             
  553.     move.l    Class(a0),d1    ; Message->Class
  554.     andi.l    #VANILLAKEY,d1
  555.     cmpi.l    #VANILLAKEY,d1
  556.     beq.s    _getvanillakey
  557.  
  558.     ; no vanilla key event -> quit
  559.     bra.s    _quitintuiinkey 
  560.  
  561. _getvanillakey:
  562.     ; there's a vanilla key event
  563.     move.w    Code(a0),d1    ; Message->Code
  564.     andi.b    #$ff,d1
  565.  
  566.     ; construct string
  567.     movea.l    #_inkeybuf,a0
  568.     move.b    d1,(a0)+
  569.     move.b    #0,(a0)
  570.  
  571.     ; reply to message
  572.     jsr    _ClearIntuiEvent
  573.  
  574.     ; return address of string
  575.     move.l    #_inkeybuf,d0    
  576.     
  577.     rts
  578.     
  579. _quitintuiinkey:
  580.     ; no event or no vanilla key -> return NULL string
  581.     movea.l    #_inkeybuf,a0
  582.     move.b    #0,(a0)
  583.  
  584.     move.l    #_inkeybuf,d0    ; return address of string
  585.  
  586.     rts
  587.                         
  588. _stdinkey:    
  589.     move.l    _DOSBase,a6
  590.  
  591.     ; check for pending character(s)
  592.     move.l    _stdin,d1
  593.     moveq    #1,d2            ; wait 1 microsecond
  594.     jsr    _LVOWaitForChar(a6)
  595.     cmpi.w    #0,d0
  596.     bne.s    _readinkey
  597.  
  598.     move.l    #_inkeybuf,a0        
  599.     move.b    #0,(a0)            ; NULL string
  600.  
  601.     move.l    #_inkeybuf,d0        ; return address of string
  602.     
  603.     rts
  604.  
  605. _readinkey:
  606.     ; read one character
  607.     move.l    _stdin,d1
  608.     move.l    #_inkeybuf,d2
  609.     moveq    #1,d3
  610.     jsr    _LVORead(a6)
  611.         
  612.     move.l    #_inkeybuf,a0        
  613.     addq    #1,a0
  614.     move.b    #0,(a0)            ; EOS
  615.  
  616.     move.l    #_inkeybuf,d0        ; return address of string
  617.  
  618.     rts
  619.  
  620. ;
  621. ; SPACE$(n) - returns the address of a string (in d0) with n spaces. d0=n.
  622. ;        - destination string address in a0.
  623. ;
  624. _spacestring:
  625.     move.l    a0,_spacestraddress
  626.  
  627.     cmpi.w    #0,d0
  628.     ble.s    _quitspacestring    ; n <= 0 -> quit
  629.  
  630.     cmpi.w    #MAXSTRINGSIZE,d0
  631.     blt.s    _buildspacestring
  632.     move.w    #MAXSTRINGSIZE-1,d0    ; n >= MAXSTRINGSIZE -> clip
  633.  
  634. _buildspacestring:
  635.     move.b    #32,(a0)+
  636.     subq.w    #1,d0
  637.     cmpi.w    #0,d0
  638.     bgt.s    _buildspacestring
  639.         
  640. _quitspacestring:
  641.     move.b    #0,(a0)
  642.     move.l    _spacestraddress,d0
  643.  
  644.     rts
  645.  
  646. ;
  647. ; SPC(n) - returns the address of a string (in d0) with n spaces. d0=n.
  648. ;     - destination string address in a0.
  649. ;
  650. _spc:
  651.     move.l    a0,_spacestraddress
  652.  
  653.     cmpi.w    #0,d0
  654.     ble.s    _quitspcstring        ; n <= 0 -> quit
  655.  
  656.     cmpi.w    #255,d0
  657.     blt.s    _buildspcstring
  658.     move.w    #255,d0            ; n >= MAXSTRINGSIZE -> clip
  659.  
  660. _buildspcstring:
  661.     move.b    #32,(a0)+
  662.     subq.w    #1,d0
  663.     cmpi.w    #0,d0
  664.     bgt.s    _buildspcstring
  665.         
  666. _quitspcstring:
  667.     move.b    #0,(a0)
  668.     move.l    _spacestraddress,d0
  669.  
  670.     rts
  671.  
  672. ;
  673. ; STRING$(n,m) - returns the address of a string (in d0) with n characters
  674. ;         of ASCII value m. d0=n, d1=m.
  675. ;           - destination string address in a0.
  676. ;
  677. _stringstr:
  678.     move.l    a0,_stringstraddress
  679.  
  680.     cmpi.w    #0,d0
  681.     ble.s    _quitstringstr        ; n <= 0 -> quit
  682.  
  683.     cmpi.w    #MAXSTRINGSIZE,d0
  684.     blt.s    _buildstringstr
  685.     move.w    #MAXSTRINGSIZE-1,d0    ; n >= MAXSTRINGSIZE -> clip
  686.  
  687. _buildstringstr:
  688.     move.b    d1,(a0)+
  689.     subq.w    #1,d0
  690.     cmpi.w    #0,d0
  691.     bgt.s    _buildstringstr
  692.         
  693. _quitstringstr:
  694.     move.b    #0,(a0)
  695.     move.l    _stringstraddress,d0
  696.  
  697.     rts
  698.  
  699. ;
  700. ; INSTR([I,],X$,Y$) - returns the first occurrence of Y$ in X$.
  701. ;            - the search starts from MID$(X$,I,1).
  702. ;            - if I is not specified, it takes on a value of 1.
  703. ;            - the result is returned in d0. 
  704. ;            - d0=I, a0=X$, a1=Y$.
  705. ;
  706. _instr:
  707.     ; result in case of error
  708.     move.l    #0,_instrposn
  709.  
  710.     ; store the parameters
  711.     move.l    d0,_search_offset    ; I
  712.     move.l    a0,_x_string        ; X$
  713.     move.l    a1,_y_string        ; Y$
  714.     move.b    (a1),_targetch        ; first character of Y$
  715.  
  716.     ; is I < 1 ?
  717.     cmpi.l    #1,_search_offset
  718.     blt    _quitinstr        ; I <= 0 -> result=0
  719.  
  720.     ; find length of X$
  721.     movea.l    _x_string,a2
  722.     jsr    _strlen
  723.     move.l    d0,_x_strlen
  724.  
  725.     ; is X$="" ? 
  726.     cmpi.l    #0,d0
  727.     beq    _quitinstr        ; X$="" -> result=0
  728.  
  729.     ; is I > len(X$) ?
  730.     move.l    _search_offset,d1
  731.     cmp.l    d0,d1
  732.     bgt    _quitinstr        ; I > LEN(X$) -> result=0
  733.  
  734.     ; find length of Y$
  735.     movea.l    _y_string,a2
  736.     jsr    _strlen
  737.     move.l    d0,_y_strlen
  738.  
  739.     ; is len(Y$) > len(X$) ?
  740.     move.l    _x_strlen,d0
  741.     move.l    _y_strlen,d1
  742.     cmp.l    d0,d1
  743.     bgt    _quitinstr        ; len(Y$) > len(X$) -> result=0
  744.     
  745.     ; is Y$="" ?
  746.     cmpi.l    #0,_y_strlen
  747.     bne.s    _search_x_for_y        
  748.  
  749.     move.l    _search_offset,_instrposn
  750.     bra.s    _quitinstr        ; Y$="" -> result=I    
  751.  
  752. _search_x_for_y:
  753.           ; compare first character only
  754.     movea.l    _x_string,a0        ; A=address of first character in X$
  755.     adda.l    _search_offset,a0    ; A=A+I    
  756.     suba.l    #1,a0            ; A=A+I-1 (adjust to start at 0th byte)
  757.     move.b    (a0),d0
  758.     move.b    _targetch,d1        ; get first character from Y$
  759.     cmp.b    d0,d1
  760.     beq.s    _check_whole_string    ; first characters match
  761.     bra.s    _inc_search_offset    ; try next character
  762.  
  763. _check_whole_string:        
  764.     ; get MID$(X$,I,len(Y$))
  765.     movea.l    _x_string,a0    
  766.     lea    _tmpstring,a1
  767.     move.l    _search_offset,d0
  768.     move.l    _y_strlen,d1
  769.     jsr    _midstr            ; a0 = MID$(X$,I,len(Y$)) -> _streq
  770.  
  771.     ; is MID$(X$,I,len(Y$)) = Y$ ?
  772.     movea.l    _y_string,a1
  773.     jsr    _streq
  774.     cmpi.l    #0,d0
  775.     beq.s    _inc_search_offset    ; MID$(X$,I,len(Y$)) <> Y$ -> ++I
  776.     
  777.     ; found it!
  778.     move.l    _search_offset,_instrposn
  779.     bra.s    _quitinstr
  780.     
  781. _inc_search_offset:
  782.     add.l    #1,_search_offset
  783.     move.l    _x_strlen,d0
  784.     move.l    _search_offset,d1
  785.     cmp.l    d0,d1
  786.     ble.s    _search_x_for_y        
  787.         
  788. _quitinstr:
  789.     move.l    _instrposn,d0
  790.         
  791.     rts
  792.  
  793. ;
  794. ; BIN$ - returns binary string form (a0) of long decimal value (d0).
  795. ;
  796. _binstr:
  797.      move.l     a0,a3          ; save address of dest string
  798.  
  799.     ; if zero, make a string with 1 digit: "0"
  800.     cmpi.l     #0,d0
  801.     bne.s     _binnotzero
  802.     move.b     #48,(a0)+     ; string[0]='0'
  803.     move.b    #0,(a0)        ; EOS
  804.     movea.l    a3,a0
  805.     rts
  806.  
  807. _binnotzero:
  808.      move.w     #0,d2          ; cc=0
  809.      lea     _bindigit,a0
  810.  
  811. _binloop:
  812.      cmpi.l     #0,d0
  813.      beq.s     _revdigits     ; until num == 0
  814.  
  815.      ; get remainder
  816.      move.l     d0,d1          ; num
  817.      move.l     d0,d3  
  818.      lsr.l     #1,d3          ; num\2
  819.      lsl.l     #1,d3          ; quotient*2
  820.      sub.l     d3,d1          ; r=num-(quotient*2) = num % 2
  821.   
  822.      add.l     #48,d1         ; ASCII = 48 + d1
  823.      and.b     #$ff,d1  
  824.      move.b     d1,(a0)+     ; x[cc]=r
  825.      addi.w     #1,d2          ; cc++ (keep count of characters)
  826.  
  827.      lsr.l     #1,d0          ; num \= 2
  828.  
  829.      bra.s     _binloop
  830.  
  831. _revdigits:
  832.      move.l     a3,a1  ; string address
  833.  
  834. _makebinstring:
  835.      cmpi.w     #0,d2
  836.      ble.s     _stripbinzeros     ; while cc > 0
  837.  
  838.      subi.w     #1,d2  ; --cc
  839.      move.b     -(a0),(a1)+     ; string[cc] = x[cc]
  840.  
  841.      bra.s     _makebinstring
  842.     
  843. _stripbinzeros:
  844.      move.b     #0,(a1)      ; EOS
  845.      move.l     a3,a1          ; start of string 
  846.     
  847. _binstriploop:
  848.      ; strip leading zeros
  849.      cmpi.b     #0,(a1)
  850.      beq.s     _exitbinstr     ; exit if EOS (null string?)
  851.  
  852.      cmpi.b     #48,(a1)
  853.      bgt.s     _exitbinstr     ; digit > 0? -> exit 
  854.  
  855.      adda.l     #1,a1
  856.  
  857.      bra.s     _binstriploop
  858.   
  859. _exitbinstr:  
  860.      move.l     a1,a0          ; return destination string address
  861.     rts
  862.  
  863.     END
  864.